perm filename IOSER[S,AIL]8 blob
sn#053548 filedate 1973-07-13 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00035 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00004 00002 HISTORY
00008 00003 Indices, Bits for IOSER
00010 00004 Simio, Ioinst, Lpryer, Cserr
00014 00005 Getchn
00017 00006 Filnam
00020 00007 Flscan
00022 00008 Open
00027 00009
00032 00010 Release
00035 00011 Lookup, Enter
00038 00012 Fileinfo
00040 00013 Out
00043 00014 Input
00052 00015 Realin, Realscan
00054 00016 Intin, Intscan
00056 00017
00059 00018
00063 00019
00065 00020
00066 00021
00068 00022
00070 00023 Arryout, Wordout
00074 00024 Arryin, Wordin
00079 00025 Linout
00082 00026 Breakset
00086 00027 Setbreak
00088 00028 Stdbrk
00090 00029 Close, Closin, Closo
00092 00030 Mtape
00094 00031 Useti, Useto, Rename
00096 00032 Usercon
00098 00033 Ttyuuo functions
00101 00034
00110 00035 Ptyuuo functions
00118 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 202000000055 ⊗;
COMMENT ⊗
VERSION 16-2(45) 5-7-73 BY JRL CHANGE PTYALL TO HANDLE LARGER BUFFERS
VERSION 16-2(44) 3-21-73 BY JRL ADD COMPIL(SAIDM3)
VERSION 16-2(43) 2-25-73 BY RHT BUG #LP# GO TO OUT OF PROCESS SHOULDNT LOOP!
VERSION 16-2(42) 2-14-73 BY RHT BUG #LM# TYPO IN PITBND
VERSION 16-2(41) 1-9-73 BY RHT REPAIR COMPIL FOR SAIPIT
VERSION 16-2(40) 12-2-72 BY RHT MODIFY PIT STUFF FOR NEW INFOTAB &DATAB
VERSION 16-2(39) 12-1-72 BY JRL CHANGE LEAP INDEX USED TO CALL FRELS WITHIN BEXIT
VERSION 16-2(38) 11-28-72 BY RHT ADD CLEANUPS TO BEXIT CODE
VERSION 16-2(37) 9-24-72 BY JRL LIBRARY REQUESTS
VERSION 16-2(36) 9-21-72 BY JRL ADD DADDY CURSCB ETC TO DUM
VERSION 16-2(35) 8-31-72 BY JRL RELEASE VALUE SETS CORRECTLY IN STKUWD
VERSION 16-2(34) 8-27-72 BY RHT CHANGE SPOT IN WHICH STKUWD SAVES RETN
VERSION 16-2(33) 8-23-72 BY JRL ADD FORGET CONTEXT CODE TO BEXIT
VERSION 16-2(32) 8-14-72 BY RHT EVAL →→ APPLY
VERSION 16-2(31) 7-22-72 BY RHT ADD KILL LIST TO BEXIT
VERSION 16-2(30) 7-12-72 BY DCS BUG #IN# PTYALL INVALID REMCHR PROBLEM
VERSION 16-2(29) 7-3-72 BY DCS MANY THINGS
VERSION 16-2(28) 6-7-72 BY DCS BUG #HO# RETURN BOTH ADDRESSES FROM ..ARCOP FOR .MES2
VERSION 16-2(27) 5-24-72 BY RHT CHANGE STKUWD TO LOOK AT PPDA
VERSION 16-2(26) 5-15-72 BY JRL ARRPDP BUG AGAIN
VERSION 16-2(24) 5-11-72 BY DCS BUG #HC# BETTER EXPO OUTSTR
VERSION 16-2(23) 5-11-72 BY DCS BUG #HA# IMPRV. ERR. ENB, FIX MUDDY FEET IN EXPO
VERSION 16-2(22) 5-11-72 BY DCS BUG #GT# ALLOW LARGE OCTAL PPNS
VERSION 15-6(17-21) 5-4-72
VERSION 15-6(17) 3-7-72 BY DCS FIX OUTSTR(NULL) GARBAGING
VERSION 15-6(7-16) 2-20-72
VERSION 15-6(6) 2-18-72 BY RHT CREATE THE NEW WORLD
VERSION 15-2(5) 2-6-72 BY DCS BUG #FQ# {WD-ARRY}{IN-OUT} WORD COUNT KEPT RIGHT, IOERR OK, DUMP MODE OK
VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
VERSION 15-2(3) 2-1-72 BY DCS BUG #GF# INCHWL BREAKS ON MORE THINGS, TELLS WHAT THEY ARE
VERSION 15-2(2) 1-25-72 BY DCS BUG #GD# Fix non-standard buffer size setup in OPEN
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
COMMENT ⊗Indices, Bits for IOSER ⊗
LSTON (IOSER)
IFN ALWAYS,<BEGIN IOSER>
DSCR IOSER -- IOSER GENERAL DISCUSSION
;SEE GOGOL FOR MORE DETAILS
; FORMAT OF CDBs
DMODE ←← 0 ;DATA MODE
DNAME ←← 1 ;DEVICE
BFHED ←← 2 ;HEADER POINTERS
OBPNT ←← 3 ;OUTPUT BUFFER POINTER
OBP ←← 4 ;OUTPUT BYTE POINTER
OCOWNT ←← 5 ;OUTPUT BYTE COUNT
ONAME ←← 6 ;OUTPUT FILE NAME -- FOR INFORMATION ONLY
OBUF ←← 7 ;OUTPUT BUFFER LOCATION
IBPNT ←←10 ;SAME STUFF FOR INPUT
IBP ←←11
ICOWNT ←←12
INAME ←←13
IBUF ←←14
ICOUNT ←←15 ;INPUT DATA COUNT LIMIT ADDRESS
BRCHAR ←←16 ;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
TTYDEV ←←16 ;LH -1 IF DEVICE IS A TTY -- USED BY OUT
ENDFL ←←17 ;INPUT END OF FILE FLAG ADDR
ERRTST ←←20 ;USER ERROR BITS SPECIFICATION WORD
PGNNO ←←21 ;SAME THING IF IT IS INCLUDED
; SIMIO INDICES
↓IOSTATUS ←←0
↓IOIN ←←1 ;SEE EXPLANATIONS IN SIMIO ROUTINE
↓IODIN ←←2
↓IOOUT ←←3
↓IODOUT ←←4
↓IOCLOSE ←←5
↓IORELEASE ←←6
↓IOINBUF ←←7
↓IOOUTBUF ←←10
↓IOSETI ←←11
↓IOSETO ←←12
; 13 UNUSED
↓IOOPEN ←←14
↓IOLOOKUP ←←15
↓IOENTER ←←16
↓IORENAME ←←17
⊗
COMPIL(SIM,<SIMIO,CSERR,LPRYER>,<GOGTAB>
,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
COMMENT ⊗Simio, Ioinst, Lpryer, Cserr ⊗
DSCR SIMIO
CAL XCT INDEX,SIMIO
PAR AC field is index into instruction table (see below)
CHNL contains I/O channel number
other params can be gleaned from instruction table
RES an I/O instruction is executed. Routine skips if I/O instr did.
If the INDEX is ≤12, and if the instruction skips (error or EOF),
status is presented in LH of user's EOF vbl (@ENDFL(CDB)), so he
can test it, or an error message is provided (depending on user-
enabling). This simplifies many I/O routines.
SID NONE
DES This routine makes I/O instructions re-entrant. The problem is
that the channel cannot be referenced indirectly.
⊗
↑↑SIMIO: PUSHJ P,.+1 ;SAVE PC OF XCT
PUSH P,C ;SAVE C
MOVE C,-1(P) ;ASSUME SKIP RETURN
LDB C,[POINT 4,-1(C),12] ;INDEX OF XCT
JUMPE C,USTST ;WANT STATUS BITS ONLY
CAIL C,13 ;NOW SPLIT HIGH AND LOW INDICES
JRST ALTIO ;SKIP RETURN CHECK ONLY
MOVE C,IOINST(C) ;GET INSTRUCTION
DPB CHNL,[POINT 4,C,12] ;CHANNEL NUMBER
XCT C ;DO OPERATION
JRST USOUT ;ALL KOSHER, NO EOF OR ERR
USTST: MOVE C,[GETSTS C] ;WHA-
DPB CHNL,[POINT 4,C,12] ; T HAPPEN-
XCT C ; ED?
TRZ C,10000 ;IOACT BIT, USER LOOKUP CHECK BIT
HRLZM C,@ENDFL(CDB) ;GIVE USER THE BITS
TDNN C,ERRTST(CDB) ;ANY HE CAN'T HANDLE?
JUMPA CHNL,USSKIP ;NOPE, JUST SKIP-RETURN
ERR <I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
USSKIP: AOS -1(P) ;SKIP-RETURN
USOUT: POP P,C ;RESTORE C
POPJ P, ;DONE
ALTIO: MOVE C,IOINST(C) ;GET INSTR
DPB CHNL,[POINT 4,C,12]
XCT C ;DO IT
JRST USOUT ;NO SKIP
JRST USSKIP ;SKIP
DSCR INSTRUCTION TABLE
⊗
IOINST←.-1 ;IOSTATUS ←← 0 GET STATUS
IN ;IOIN ←← 1 BUFFERED INPUT
IN D ;IODIN ←← 2 DUMP MODE INPUT
OUT ;IOOUT ←← 3 BUFFERED OUTPUT
OUT D ;IODOUT ←← 4 DUMP MODE OUTPUT
CLOSE (D) ;IOCLOSE ←← 5 CLOSE I,O, OR BOTH
;; ALLOW USE OF INHIBIT BITS IN RELEASE
RELEASE (D) ;IORELEASE←← 6
INBUF (A) ;IOINBUF ←← 7
OUTBUF (A) ;IOOUTBUF ←←10
USETI (A) ;IOSETI ←←11
USETO (A) ;IOSETO ←←12
0 ; UNUSED
OPEN DMODE(CDB) ;IOOPEN ←←14
LOOKUP FNAME(USER);IOLOOKUP←←15
ENTER FNAME(USER);IOENTER ←←16
RENAME FNAME(USER);IORENAME←←17
HERE(CSERR) MOVE USER,GOGTAB
POP P,UUO1(USER) ;STANDARD PLACE
ERR <CASE INDEX OVERFLOW, VALUE IS >,13
JRST @UUO1(USER) ;RETURN OK
HERE (LPRYER) ERR <DATUM OF ARRAY NOT THERE>,1
POPJ P,
ENDCOM(SAV)
COMPIL(CHN,<GETCHN,NOTOPN,GETCHAN>,<GOGTAB>,<GETCHN, NOTOPN, GETCHAN>)
COMMENT ⊗Getchn ⊗
DSCR Getchn, Getchan
PAR A -- addr of ASCII for routine name
CHNL -- I/O channel number from SAIL call
RES -- CHNL contains actual I/O channel number (diff for shared TTY)
CDB contains → actual CDB table for that channel
SID A(lh) is changed
DES normally just sets up CHNL and CDB
if error occurs (channel out of bounds, already open), a fatal message
is printed, using the address in A to get the routine name.
This routine is called by most I/O routines, having saved ACs and
fetched CHNL.
⊗
GETCHN:
HRLI A,(<TTCALL 3,0>) ;PREPARE FOR ERR MESS
TRZE CHNL,777760 ;CHECK FOR VALID CHANNEL NO
JRST NOTVALID ;INVALID CHANNEL NUMBER
SKIPE CDB,@CDBLOC(USER) ;IS CHANNEL OPEN? (CDBLOC SET BY ALLOC)
POPJ P,
NOTOPN:
XCT A ;PRINT ROUTINE NAME
ERR <: CHANNEL OR FILE NOT OPEN>
NOTVALID:
XCT A ;ROUTINE NAME
ERR <: CHANNEL NUMBER INVALID>
DSCR INTEGER←GETCHAN;
CAL SAIL
⊗
HERE (GETCHAN)
MOVE USER,GOGTAB
ADD USER,[XWD A,CHANS] ;MAKE @ WORD
MOVEI A,1 ;START AT CHANNEL 1
CHLUP: SKIPN @USER ;IF CHANNEL IS FREE,
POPJ P, ; RETURN
CAIGE A,17 ;CYCLE TO 0?
AOJA A,CHLUP ;NO, TRY NEXT
MOVEI A,0 ;TRY 0
SKIPE @USER ;FREE?
HRROI A,-1 ;NOPE
POPJ P, ;DONE
ENDCOM(CHN)
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
COMMENT ⊗Filnam ⊗
DSCR FILNAM
CAL PUSHJ
PAR file name string on SP stack
of form FILENAME<.EXT><[PROJ,PROG]>
RES FNAME(USER) : SIXBIT /filename/
EXT(USER): SIXBIT /extension,,0/
0
PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
⊗
↑↑FILNAM:
SUB SP,X22 ;ADJUST STACK
FOR II←1,3 <
SETZM FNAME+II(USER)>
MOVEI X,FNAME(USER) ;WHERE TO PUT IT
PUSHJ P,FLSCAN ;GET FILE NAME
JUMPE Y,FLDUN ;FILE NAME ONLY
CAIE Y,"." ;EXTENSION?
JRST FLEXT ;NO, CHECK PPN
MOVEI X,FNAME+1(USER)
PUSHJ P,FLSCAN
FLEXT: JUMPE Y,FLDUN ;NO PPN SPECIFIED
CAIE Y,"["
JRST FLERR ;INVALID CHARACTER
PUSHJ P,[
RJUST: SETZM PROJ(USER)
MOVEI X,PROJ(USER)
PUSHJ P,FLSCAN ;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
MOVE X,PROJ(USER)
IMULI D,-6 ;SHIFT FACTOR
LSH X,(D) ;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
IFE SIXSW,<
MOVEI X,0
;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
MOVE D,PROJ(USER) ;WAS A HLLZ
;;
FBACK: MOVEI C,0
LSHC C,6 ;GET A SIXBIT CHAR
CAIL C,'0'
CAILE C,'7'
JRST FLERR ;INVALID OCTAL
LSH X,3
IORI X,-'0'(C)
JUMPN D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
FPOP: POPJ P,]
HRLZM X,FNAME+3(USER)
CAIE Y,","
JRST FLERR ;INVALID CHAR
PUSHJ P,RJUST ;JUSTIFY(AND CONVERT IF EXPORT) PROG #
HRRM X,FNAME+3(USER)
CAIN Y,"]"
FLDUN: AOS (P) ;SUCCESSFUL
FLERR: POPJ P, ;DONE, NOT NECESSARILY RIGHT
ENDCOM(FIL)
COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
COMMENT ⊗Flscan ⊗
DSCR FLSCAN
CAL PUSHJ
PAR X -- addr of destination SIXBIT
1(SP), 2(SP) -- input string
RES sixbit for next filename, etc in word addressed by X
break (punctuation) char in Y (0 if string exhausted)
D,X, input string adjusted
SID only those AC changes listed above (Y, for instance)
⊗
↑↑FLSCAN:
HRRZS 1(SP) ;WANT ONLY LENGTH PART
MOVEI D,6 ;MAX NUMBER PICKED UP
SETZM (X) ;ZERO DESTINATION
HRLI X,440600 ;BYTE POINTER NOW
FLN1: MOVEI Y,0 ;ASSUME NO STRING LEFT
SOSGE 1(SP) ;TEST 0-LENGTH STRING
POPJ P,
ILDB Y,2(SP) ;GET BYTE
CAIE Y,"." ;CHECK VALID BREAK CHAR
CAIN Y,"["
POPJ P,
CAIE Y,"]"
CAIN Y,","
POPJ P,
JUMPE D,FLN1 ;NEED NO MORE CHARS
TRZN Y,100 ;MOVE 100 BIT TO 40 BIT
TRZA Y,40 ; TO CONVERT TO SIXBIT
TRO Y,40 ; (NO CHECKING)
IDPB Y,X ;PUT IT AWAY
SOJA D,FLN1 ;CONTINUE
ENDCOM(FLS)
COMPIL(OPN,<OPEN,RELEASE>,<SAVE,RESTR,CORGET,FLSCAN,SIMIO,X33,X22,X11,CORREL>
,<OPEN AND RELEASE ROUTINES>)
COMMENT ⊗Open ⊗
DSCR OPEN(CHAN,"DEV",MODE,IBFS,OBFS,@INCNT,@INBRCHR,@INEOF);
CAL SAIL
⊗
COMMENT ⊗
Allocate IBFS input and OBFS output buffers on channel CHAN for
device DEV(SAIL/GOGOL string). Store INCNT, and the INBCHR and INEOF
addresses in a newly allocated CDB (channel data block). Store
all necessary information to carry out I/O on this channel
in the CDB. Mark the channel open.
⊗
.OPN:
HERE (OPEN)
; FIRST RELEASE IF ALREADY OPEN
PUSH P,-7(P)
PUSHJ P,RELEASE ;SIMPLE
; NEXT SAVE AC'S, SET UP USER REGISTER, OBTAIN A CDB
PUSHJ P,SAVE ;SAVE ACS
MOVEI C,IOTLEN ;SIZE
PUSHJ P,CORGET ;OBTAIN A BLOCK
JRST BADOPN ;CAN'T GET IT
MOVE CDB,B ;CDB→CHANNEL TABLE
MOVEI LPSA,0 ;NOW GET READY IN CASE OF ERROR
SUB SP,X22
; FILL IT WITH NON-CONTROVERSIAL THINGS
POP P,TEMP ;RETURN ADDRESS
POP P,ENDFL(CDB) ;END OF FILE FLAG ADDRESS
POP P,BRCHAR(CDB) ;BREAK CHAR ADDRESS
POP P,ICOUNT(CDB) ;INPUT COUNT ADDRESS
POP P,OBUF(CDB) ;NUMBER OF OUTPUT BUFFERS
POP P,IBUF(CDB) ;NUMBER OF INPUT BUFFERS
POP P,Z ;DATA MODE
POP P,CHNL ;DATA CHANNEL
CHKCHN CHNL,<OPEN> ;ASSURE VALID
;;#HA# DCS 5-11-72 IMPROVE ERROR ENABLE. ALSO, IN EXPO SYSTEM,
;; AVOID REFERENCES TO PGNNO, WHICH IS ≡ ERRTST!
HRRZI X,750000 ;ERROR BITS POSSIBLY ENABLED -- WAS A HRROI
;;#HA#
ANDCM X,Z ;ERROR BITS ACTUALLY ENABLED ARE 0
MOVEM X,ERRTST(CDB) ;SAVE ENABLATIONS
TRZ Z,750000 ;REMOVE IRRELEVANT BITS
TLNE Z,-1 ;CHECK VALIDITY SOMEWHAT
ERR <OPEN: INVALID DATA MODE>,1
MOVEM Z,DMODE(CDB) ;STORE MODE
;;#HA# SEE JUST ABOVE
NOEXPO <
SETZM PGNNO(CDB) ;PAGE NUM FOR DISPLAY FEATURE
>;NOEXPO
;;#HA#
; GET DEVICE NAME
MOVEI X,DNAME(CDB) ;WHERE SIXBIT'S TO GO
PUSHJ P,FLSCAN ;GET DEVICE NAME
SKIPE Y ;ASSURE VALID SIXBIT
ERR <OPEN: INVALID DEVICE NAME>,1
;IF TTY, MARK TTYDEV FOR OUT
HLRZ TEMP,DNAME(CDB) ;GET LH DEVICE NAME
MOVSI Z,400000 ;BIT TO MARK WITH
CAIE TEMP,'TTY' ;IF TTY OR PTY,
CAIN TEMP,'PTY' ; ,
IORM Z,TTYDEV(CDB); IT'S A TTY
; NOW SET HEADER PTRS IN CDB
HRRZI Z,-1 ;TO TEST RIGHT HALF
SETZM BFHED(CDB) ;CLEAR HEADER POINTER
LDB E,[POINT 4,DMODE(CDB),35] ;DATA MODE
CAIL E,15 ;DUMP MODE?
JRST AGNN ; YES, NO BUFFER HEADER WORD
MOVEI TEMP,OBPNT(CDB) ;IF OUTPUT, SET POINTER
TDNE Z,OBUF(CDB) ;ANY OUTPUT BUFFERS?
HRLM TEMP,BFHED(CDB)
MOVEI TEMP,IBPNT(CDB) ;SAME FOR INPUT
TDNE Z,IBUF(CDB) ;ANY INPUT BUFFERS?
HRRM TEMP,BFHED(CDB)
; NOW OPEN THE FILE, GET THE BUFFERS,ETC.
AGNN: XCT IOOPEN,SIMIO ; OPEN CHAN,MODE
JRST [SKIPE @ENDFL(CDB) ;DOES USER WANT TO KNOW?
JRST NORELO ;YES, RELEASE CDB, ERASE ALL OF ATTEMPT
JRST RTRY]
COMMENT ⊗
ERMAN'S IMPROVED BUFFER GETTER --- DEC. 1970
If a buffer size is specified (lh #buf word), allocate that size, else the
standard size (determined via a dummy XXXBUF, clever soul that LDE is).
"NOTICE WITH AWE THAT NO CORE IS EVER WASTED, AS IN THE INFERIOR OLD WAY" (sic).
⊗
MOVEI Z,0 ;FOR DUMMY (AND REAL) OUTBUF
PUSHJ P,GETBFS ;GET CORE, DO THE OUTBUFS (OR SIMULATIONS)
ADDI CDB,OBUF-OBPNT+1 ;RELOCATE FOR INPUT IN CDB
MOVEI Z,-1
PUSHJ P,GETBFS ;GET CORE, DO INBUFS
SUBI CDB,OBUF-OBPNT+1;RE-RELOCATE
; FINISH OUT -- SET EOF FLAG IF DESIRED
STNIT: ;SETOM JOBFF ;ONE MUST KNOW WHAT HE IS DOING TO USE
MOVEM CDB,@CDBLOC(USER) ;STORE CDB ADDR IN CHANS TABLE
SETZM @ENDFL(CDB) ;MARK OPEN SUCCESSFUL
JRST RESTR ;RESTORE ACS, RETURN
BADOPN: HRRZ TEMP,JOBREN ;NEXT START WILL ASK ALLOC
HRRM TEMP,JOBSA ;QUESTION
ERR <TOO MANY CHANNELS OR I/O BUFFERS REQUESTED>,1,<(TEMP)>
RTRY: TERPRI <OPEN: DEVICE NOT AVAILABLE>
TERPRI <TYPE "R" TO RETRY, "X" TO BLOW UP>
PRINT <?>
TTCALL TEMP
CAIN TEMP,"R" ;TRY AGAIN?
JRST AGNN ;YES
CALLI 12 ;EXIT
GETBFS: SETZM ONAME(CDB) ;CLEAR FILE NAME
HRRZ Y,OBUF(CDB) ;NUMBER OF BUFFERS
HLRZ D,OBUF(CDB) ;SIZE
JUMPE Y,GBUFRT ;NO BUFFERS
JUMPE D,GETDES ;WANTS DEFAULT SIZE
ANDI D,7777 ;MAX BUFFER SIZE
HRLZ A,D ;SIZE IN LH
PUSHJ P,GETCOR ;GET THE CORE (SURPRISE!)
SETZM OCOWNT(CDB) ;IN CASE NO ACTUAL INBUF (OUTBUF) DONE
CAIL E,15 ;DUMP MODE?
JRST GBUFRT ; YES, DON'T ACTUALLY FUDGE UP BUFFERS
NOEXPO <;USE UINBF, UOUTBF
;;#GD# 01-25-72 DCS (1-2) set up JOBFF, Fix XCT, bad count
MOVEM B,JOBFF ;B FROM CORGET HAS BUFFER AREA ADDRESS
SUBI D,2 ;GETCOR INCREMENTED
;;#GD#
HRRZ C,Y
MOVE A,[UINBF C]
JUMPN Z,.+2
MOVE A,[UOUTBF C]
DPB CHNL,[POINT 4,A,12]
;;#GD# 01-25-72 DCS (2-2) (was XCT CHNL, clearly wrong)
XCT A ;DO THE ALLOCATIONS
;;#GD#
POPJ P,
>;NOEXPO
EXPO <
ADDI B,1 ;SECOND WORD
BUFC1: HRR A,B
SOJLE Y,BUFC2
ADD B,D ;NEXT ONE
MOVEM A,(B) ;MAKE POINT TO PREV
JRST BUFC1
BUFC2: MOVE B,OBUF(CDB) ;BACK TO FIRST
MOVEM A,1(B) ;LINK IT TOO
HRLI A,400000 ;RING-USE BIQ
MOVEM A,OBPNT(CDB) ;BUFFER PTR
POPJ P,
>;EXPO
GETCOR: ADDI D,2 ;+2 FOR ACCOUNTING
MOVE C,D
IMUL C,Y ;TOTAL CORE NEEDED
PUSHJ P,CORGET ;GRAB IT
ERR <OPEN: NOT ENUFF CORE FOR BUFFERS>
HRRZM B,OBUF(CDB) ;SAVE SO CAN RELEASE
POPJ P,
GETDES: MOVEI A,1 ;1 DUMMY BUFFER
CAIL E,15 ;GOOD OLD DUMP MODE?
JRST [MOVEI D,202 ;ASSUME THIS, SINCE INBUF/OUTBUF WON'T
JRST GDIT] ; WORK IN DUMP MODE
MOVEI TEMP,BRKDUM-1(USER)
MOVEM TEMP,JOBFF
PUSHJ P,GETIOB ;DUMMY IN/OUBUF
LDB D,[POINT 17,BRKDUM(USER),17] ;GET THE SIZE
GDIT: PUSHJ P,GETCOR ;GET THE CORE
SETZM OCOWNT(CDB) ;CLEAR BYTE COUNT
CAIL E,15 ;DUMP MODE?
JRST GBUFRT ;YES, NO BUFFER STRUCTURE
MOVEM B,JOBFF
MOVE A,Y ;NUMBER OF BUFFERS
PUSHJ P,GETIOB ;NOW FOR REAL
GBUFRT: SETOM JOBFF ;FOR SPITE
POPJ P,
GETIOB: SKIPN Z
XCT IOOUTBUF,SIMIO ;DO OUTBUF
SKIPE Z
XCT IOINBUF,SIMIO ;INBUF
POPJ P,
SUBTTL RELEASE
COMMENT ⊗Release ⊗
DSCR RELEASE(CHANNEL NO,INHIBIT BITS);
CAL SAIL
DES THIS USES THE DEFAULT PARAMETER MECHANISM, 0 DEFAULT FOR INHIBIT BITS
⊗
COMMENT ⊗
Release channel, i/o buffers, channel table if channel is open
Adjust special TTY stuff to reflect lossage if TTY channel
⊗
HERE(RELEASE)
.RELS:
SETOM JOBFF ;MARK INVALID
PUSHJ P,SAVE ;SAVE REGS, GET USER, SAVE RETURN
;; FOLLOWING WAS MOVE LPSA,X22
MOVE LPSA,X33
;; FOLOWING WAS CHNL,-1(P)
MOVE CHNL,-2(P) ;CHANNEL #
CHKCHN CHNL,<RELEASE> ;VALIDATE
SKIPN CDB,@CDBLOC(USER) ;GET ADDR FROM CHANS TABLE-- CHANNEL OPEN?
JRST RESTR ;CHANNEL NOT OPEN, FORGET IT
SETZM @CDBLOC(USER) ;CLEAR CHANS TABLE ENTRY
;; INHIBIT BITS;
HRRZ D,-1(P) ;THE DEFAULT OR USER SPECIFIED INHIBIT BITS
XCT IORELEASE,SIMIO ;RELEASE CHAN,0
HRRZ B,IBUF(CDB) ;RELEASE ANY INPUT
PUSHJ P,BUFREL ; BUFFERS
HRRZ B,OBUF(CDB) ;ALSO OUTPUT
PUSHJ P,BUFREL ; BUFFERS
NORELO: HRRZ B,CDB ;WHERE TO RELEASE
PUSHJ P,CORREL ;GIVE CDB BACK
JRST RESTR ;RESTORE AND RETURN
BUFREL: JUMPN B,CORREL ;RELEASE IF ANY TO RELEASE
POPJ P, ;ELSE RETURN
ENDCOM (OPN)
COMPIL(LOK,<LOOKUP,ENTER,FILEINFO>
,<SAVE,RESTR,GETCHN,FILNAM,SIMIO,X33,X22,GOGTAB>
,<LOOKUP, ENTER, AND FILEINFO ROUTINES>)
COMMENT ⊗Lookup, Enter ⊗
DSCR LOOKUP(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗
Comment ⊗
LOOKUP or ENTER file FILENAME on channel CHANNEL, where FILENAME has
a format acceptable to FILNAM above. If successful,
FAILURE_FLAG (called by reference) is zeroed. It is
otherwise set to -1 in LH, error code in RH.
⊗
.LOK:
HERE (LOOKUP) PUSHJ P,SAVE
LOADI7 A,<LOOKUP>
PUSH P,[XCT IOLOOKUP,SIMIO] ;LOOKUP CH,FILE
MOVEI B,INAME ;TO STORE FILE NAME
JRST LOKENT ;DO THE OPERATION
DSCR ENTER(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗
HERE (ENTER)
PUSHJ P,SAVE
LOADI7 A,<ENTER>
PUSH P,[XCT IOENTER,SIMIO] ;ENTER CH,FILE
MOVEI B,ONAME ;TO STORE FILE NAME
LOKENT:
MOVE LPSA,X33 ;PARAM ADJUST FOR RESTR
MOVE CHNL,-3(P) ;GET CHANNEL #
PUSHJ P,GETCHN ;VALIDATE
SETZM @-2(P) ;ASSUME SUCCESS
PUSHJ P,FILNAM ;GET FILE
JRST BADSPC ; NO GOOD, REPORT ERROR
ADD B,CDB ;ADDR OF FILE NAME HOLDER
MOVEW (<(B)>,<FNAME(USER)>) ;STORE IT
;;#HA# SEE OPEN CODE
NOEXPO <
SETZM PGNNO(CDB) ;CLEAR PAGE NO FOR "D" FEATURE
>;NOEXPO
;;#HA#
POP P,X ;INSTRUCTION TO DO
MOVE Y,[JRST ELERR] ;FAILURE
MOVE Z,[JRST RESTR] ;SUCCESS
ENF1: JRST X ;ENTER/LOOKUP
BADSPC: POP P,(P) ;REMOVE IO INSTRUCTION
HRRZ TEMP,ERRTST(CDB) ;GET USER-ENABLE BITS
TRNE TEMP,10000 ;ENABLED FOR HANDLING BAD FILE SPECS?
ERR <LOOKUP OR ENTER: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
SKIPA TEMP,[=8] ;ALWAYS REPORT NO GOOD LOOKUP/ENTER
ELERR: HRRZ TEMP,FNAME+1(USER) ;WHY DID IT BLOW?
HRROM TEMP,@-1(P) ;TELL THE USER
JRST RESTR
COMMENT ⊗Fileinfo ⊗
DSCR FILEINFO(INTEGER ARRAY INFO[1:6]);
CAL SAIL
⊗
Comment ⊗ This routine gives the user the entire 6 word block
from the last LOOKUP, ENTER, or RENAME operation done by SAIL.⊗
HERE (FILEINFO)
MOVE USER,GOGTAB
POP P,UUO1(USER) ;GET RID OF IT, MARK LAST SAIL CALL
POP P,LPSA ;ARRAY ADDRESS WHERE INFO IS TO GO
SKIPGE -2(LPSA) ;MAKE SURE IT'S NOT A STRING ARRAY
ERR <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
MOVE TEMP,-1(LPSA) ;TOTAL ARRAY SIZE WORD
CAML TEMP,[XWD 1,6] ;MUST BE 1-D, AT LEAST 6 WORDS
CAMLE TEMP,[XWD 1,-1] ;BUT NOT 2-D
ERR <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
MOVEI TEMP,5(LPSA) ;BLT TERMINATOR
HRLI LPSA,FNAME(USER) ;SOURCE OF VALUABLE INFORMATION
BLT LPSA,(TEMP) ;GIVE!
JRST @UUO1(USER) ;GONE
ENDCOM (LOK)
COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
,<STRING OUTPUT ROUTINE>)
COMMENT ⊗Out ⊗
DSCR OUT(CHANNEL,"STRING");
CAL SAIL
⊗
COMMENT ⊗
Simply places all characters of string in output buffer for channel.
Close file if device is TTY ⊗
.OUT.:
HERE (OUT) PUSHJ P,SAVE ;ACS, GET USER, SAVE RETURN FOR ERROR
MOVE LPSA,X22
MOVE CHNL,-1(P) ;CHANNEL NUMBER
LOADI7 A,<OUT>
PUSHJ P,GETCHN ;VALIDATE AND GET CDB, ETC.
HRRE Z,-1(SP) ;#CHARS
POP SP,D
SUB SP,X11
MOVE B,OBP(CDB)
MOVE A,OCOWNT(CDB)
JRST .OUT1
.OUT: SOJLE A,OUT1 ;NEED OUTPUT??
.OUT2: ILDB X,D ;GET A CHAR
IDPB X,B ;PUT IT AWAY
.OUT1: SOJGE Z,.OUT ;LOOP
OUTDUN: MOVEM B,OBP(CDB) ;PUT BP AWAY
MOVEM A,OCOWNT(CDB) ;COUNT AWAY
SKIPGE TTYDEV(CDB) ;TTY?
XCT IOOUT,SIMIO ; YES, FORCE OUTPUT
JRST RESTR
JRST RESTR
OUT1: LDB TEMP,[POINT 4,DMODE(CDB),35] ;MODE
CAIL TEMP,15 ;DUMP?
JRST DMPO ;YES
MOVEM B,OBP(CDB) ;PUT REAL BP AWAY
XCT IOOUT,SIMIO ;DO THE OUTPUT
JFCL ;ERRORS HANDLED IN SIMIO
MOVE B,OBP(CDB) ;NEW BP
MOVE A,OCOWNT(CDB) ;NEW COUNT
JRST .OUT2 ;CONTINUE
; SPECIAL DUMP-MODE OUTPUT STUFF
DMPO: PUSH P,D
HRRZ D,OBUF(CDB) ;→BUFFER AREA
SUBI D,1 ;ADDR-1 FOR IOWD
HRLI D,-=128 ;-WORD COUNT
MOVEI D+1,0
XCT IODOUT,SIMIO ;OUT D,
JFCL ;ERRORS HANDLED IN SIMIO
OKO: HRRZ B,D ;SAVE ADDR
HRLI D,1(D) ;BLT WORD
HRRI D,2(D)
SETZM -1(D)
BLT D,=128(B) ;CLEAR BUFFER
POP P,D ;RESTORE INPUT BYTE POINTER
AOS @ENDFL(CDB) ;SPECIAL TREATMENT
HRLI B,700 ;POINT 7,-1(1ST WORD),35
MOVEM B,OBP(CDB)
MOVEI A,5*=128 ;CHAR COUNT
MOVEM A,OCOWNT(CDB)
JRST .OUT2 ;AFTER OUTPUT SIMULATION, GO ON
ENDCOM(OUT)
COMPIL(INP,<INPUT>
,<SAVE,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,X33,NOTOPN,GOGTAB
NOEXPO <
EXTERNAL PGDS
>;NOEXPO
>
,<STRING INPUT ROUTINE>)
COMMENT ⊗Input ⊗
DSCR "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
CAL SAIL
SID NO ACS SAVED BY INPUT!!!!!!
⊗
.IN.:
HERE (INPUT)
MOVE USER,GOGTAB ;GET TABLE POINTER
MOVEM RF,RACS+RF(USER);SAVE F-REGISTER
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVE CHNL,-2(P) ;CHANNEL #
LOADI7 A,<IN> ;ROUTINE NAME
PUSHJ P,GETCHN ;SET UP, VALIDATE
LDB E,[POINT 4,DMODE(CDB),35] ;DATA MODE
CAIGE E,15 ;DUMP MODE?
SETZM @ENDFL(CDB) ;NO, HELP USER ASSUME NO EOF,ERR
SETZM @BRCHAR(CDB) ;ASSUME NO BREAK CHAR
HRRZ A,@ICOUNT(CDB) ;MAX COUNT FOR INPUT STRING
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER) ;ENOUGH ROOM?
PUSHJ P,STRNGC ;NO, TRY TO GET SOME
SKIPL C,-1(P) ;GET TABLE #, CHECK IN BOUNDS
CAILE C,=18
ERR <IN: THERE ARE ONLY 18 BREAK TABLES>
HRRZ TEMP,USER
ADD TEMP,C ;TABLE NO(USER)
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVN B,A ;NEGATE MAX CHAR COUNT
PUSH SP,[0] ;LEAVE ROOM FOR FIRST STR WORD
PUSH SP,TOPBYTE(USER) ;SECOND STRING WORD
MOVE Q,BRKMSK(C) ;GET MASK FOR THIS TABLE
HRRZ Y,USER
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
JUMPE B,DONE1 ; BECAUSE THE AOJL WON'T
.IN: SOSG ICOWNT(CDB) ;BUFFER EMPTY?
JRST DOINP ;YES, GET MORE
IN1:
ILDB D,IBP(CDB) ;GET NEXT CHARACTER
TDNE Z,@IBP(CDB) ;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
JRST INLINN ;YES, GO SEE WHAT TO DO
IN2:
JUMPE D,.IN ;ALWAYS IGNORE 0'S
TDNE Q,@Y ;MUST WE DO SOMETHING SPECIAL?
JRST INSPC ;YES, HANDLE
MOVEC: IDPB D,TOPBYTE(USER) ;LENGTHEN STRING
AOJL B,.IN ;GET SOME MORE
JRST DONE1
INSPC: HLLZ TEMP,@Y ;IGNORE OR BREAK?
TDNN TEMP,Q ; (CHOOSE ONE)
JRST .IN ;IGNORE
; BREAK -- STORE BREAK CHAR, FINISH OFF
DONE: MOVEM D,@BRCHAR(CDB) ;STORE BREAK CHAR
MOVE Y,-1(P) ;TABLE # AGAIN
ADD Y,USER ;RELOCATE
SKIPN Y,DSPTBL(Y) ;WHAT TO DO WITH BREAK CHAR?
JRST DONE1 ;SKIP IT
JUMPL Y,APPEND ;ADD TO END OF INPUT STRING
RETAIN: SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
FOR II←1,4 <
IBP IBP(CDB)>
AOS ICOWNT(CDB)
JRST DONE1
APPEND: IDPB D,TOPBYTE(USER) ;PUT ON END
AOJA B,DONE1 ;ONE MORE TO COUNT
INEOF1: POP P,D+1 ;LEFT OVER FROM DUMP MODE ROUT
; DONE -- MARK STRING COUNT WORD
DONE1: ADDM B,REMCHR(USER) ;GIVE UP THOSE NOT USED
ADD B,@ICOUNT(CDB) ;HOW MANY DID WE ACTUALLY GET?
;;#GI# DCS 2-5-72 REMOVE TOPSTR
HRROM B,-1(SP) ;MARK RESULT, NON-CONSTANT
;;#GI#
MOVE RF,RACS+RF(USER);GET F-REGISTER BACK
SUB P,X33 ;REMOVE INPUT PARAMETER, RETURN ADDRESS
JRST @3(P) ;RETURN
; CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
; TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
; NOT A LINE NUMBER FOR NEXT TIME
; GET A NEW BUFFER
DOINP: CAIL E,15 ;DUMP MODE?
JRST DMPI ; YES
XCT IOIN,SIMIO ;IN CHAN,0
JRST IN1 ;ALL OK, CONTINUE
JRST DONE1 ;ERROR OR EOF, QUIT
; DUMP MODE SIMULATION OF SAME
DMPI: PUSH P,D+1
HRRZ D,IBUF(CDB) ;→BUFFER AREA
SUBI D,1
HRLI D,-=128
MOVEI D+1,0
XCT IODIN,SIMIO ;IN CHAN,D
JRST OKI
JRST INEOF1 ;REMOVE D,QUIT
OKI: POP P,D+1
AOS @ENDFL(CDB) ;SPECIAL TREATMENT
HRLI D,700
MOVEM D,IBP(CDB)
MOVEI A,5*=128
MOVEM A,ICOWNT(CDB)
JRST IN1 ;DONE SIMULATING, RETURN
INLINN:
NOEXPO <
SKIPN PGNNFL(USER) ;WANT LINE NO DISPLAY?
JRST NOPGNN ;NO
MOVE TEMP,@IBP(CDB)
TRO TEMP,1
MOVEM TEMP,PGDS+7 ;STORE IN BUFFER
CAMN TEMP,[ASCID / /]
AOS PGNNO(CDB)
MOVE TEMP,PGNNO(CDB)
ADDI TEMP,1
PUSH P,TEMP+1
IDIVI TEMP,=10
ADDI TEMP,60
DPB TEMP,[POINT 7,PGDS+5,20]
ADDI TEMP+1,60
DPB TEMP+1,[POINT 7,PGDS+5,27]
POP P,TEMP+1
MOVNI TEMP,1 ;GET CHARACTERISTICS
TTCALL 6,TEMP ; OF CONSOLE
TLNE TEMP,400000 ;DON'T DISPLAY IF NOT ON A DISPLAY DEVICE
DPYOUT 16,PGDS
>;NOEXPO
NOPGNN:
MOVE TEMP,-1(P) ;GET LINE NUMBER DISPOSITION FLAG,
ADD TEMP,USER ;RLC+TABLE
SKIPGE TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
JRST GIVLIN ; WANTS IT NEXT TIME OR SOMETHING
JSP TEMP,EATLIN ;TOSS IT OUT, AND
JRST .IN ; CONTINUE
EATLIN:
AOS IBP(CDB) ;FORGET IT ENTIRELY
MOVNI 5 ;INDICATE SKIPPING SIX
ADDB ICOWNT(CDB) ;IN COUNT
SKIPLE ;OVERFLOW BUFFER?
JRST (TEMP) ;NO, CONTINUE
CAIL E,15
ERR <CAN'T HANDLE THIS FILE IN DUMP MODE>
XCT IOIN,SIMIO ;YES, GET TAB FROM NEXT BUFFER
JRST OKLN ;GOT IT, CONTINUE
JRST DONE1
OKLN: SOSG ICOWNT(CDB) ;IF ONLY ONE CHAR,
JRST [MOVEI TEMP,20000 ;THEN EOF COMES NEXT
IORM TEMP,@ENDFL(CDB)
JRST DONE1] ;ALL DONE
IBP IBP(CDB) ;GET OVER TAB FINALLY
JRST (TEMP) ;AND CONTINUE
GIVLIN: TRNE TEMP,-1 ;WANT LINE NO IN BRCHAR WORD?
JRST GVLLN ;NO, WANTS IT NEXT TIME.
SKIPL TEMP,@IBP(CDB) ;NEGATED LINE NO
MOVNS TEMP
MOVEM TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
JSP TEMP,EATLIN ;GO EAT UP LINE NUMBER AND
JRST DONE1 ;FINISH UP
GVLLN:
SETOM @BRCHAR(CDB) ;TELL THE USER
AOS ICOWNT(CDB) ;REVERSE THE SOSLE
MOVEI Y,1 ;TURN OFF LINE NUMBER
ANDCAM Y,@IBP(CDB) ; BIT
MOVSI Y,070000 ;BACK UP BYTE POINTER
ADDM Y,IBP(CDB)
JRST DONE1 ;FINISH OFF IN BAZE OF GORY
ENDCOM(INP)
COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.>
,<LOU PAUL'S NUMBER INPUT AND CONVERSION ROUTINES>)
COMMENT ⊗Realin, Realscan ⊗
DSCR REAL←REALIN(CHANNEL NUMBER);
CAL SAIL
⊗
HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>
PUSHJ P,SAVE
PUSHJ P,NUMIN; GET NUMBER IN A AND TEN EXPONENT IN C
MOVE LPSA,X22
JRST REALFN
DSCR REAL←REALSCAN(@"STRING");
CAL SAIL
⊗
HERE (REALSCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN
MOVE LPSA,X33
REALFN: SETZ D,; POS SIGN
JUMPE A,ADON
JUMPG A,FPOS
SETO D,; NUMBER NEGATIVE
MOVNS A
FPOS: ;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
JFFO A,.+1; NUMBER OF LEADING ZEROS IN B
ASH A,-1(B); BIT0=0, BIT1=1
MOVN X,B; BIN EXPONENT -2
JUMPE C,FLO; IF TEN EXPONENT ZERO THEN FINISH
JUMPL C,FNEG
CAIL C,100; CHECK BOUND OF EXPOENT
JRST ERROV1
SETZ Y,
JRST TEST
FNEG: MOVNS C
CAIL C,100
JRST ERROV1
MOVEI Y,6
TEST: TRNE C,1; DEPENDING ON LOW ORDER BIT OF EXP
JRST MULT; EITHER MULTIPLY
NEXT: ASH C,-1; OR DON'T.
AOJA Y,TEST; INDEX INTO MULTIPLIER TABLE
MULT: ADD X,.CH.(Y); EXPONENT
JSP Q,LFMP
DTEST: SOJG C,NEXT
FLO: IDIVI A,1B18
FSC A,255
FSC B,234
FADR A,B
SKIPE D
MOVNS A
FSC A,(X); SCALE
JRST ALLDON
LFMP:
;MULTIPLIES AND NORMALIZES
MUL A,.MT.(Y)
TLNE A,200000
JRST (Q)
ASHC A,1
SOJA X,(Q)
SUBTTL INTIN INTEGER NUMBER INPUT ROUTINE LOU PAUL
COMMENT ⊗Intin, Intscan ⊗
DSCR INTEGER←INTIN(CHANNEL NUMBER);
CAL SAIL
⊗
HERE (INTIN)
;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
;USES NUMIN TO PERFORM FREE FIELD SCAN
PUSHJ P,SAVE
PUSHJ P,NUMIN; GET NUMBER IN A, TEN EXPONENT IN C
MOVE LPSA,X22
JRST INTFN
DSCR INTEGER←INTSCAN("STRING");
CAL SAIL
⊗
HERE (INTSCAN)
PUSHJ P,SAVE
PUSHJ P,STRIN
MOVE LPSA,X33
INTFN: JUMPE A,ADON
JUMPE C,ADON
JUMPL C,DIVOUT; IF EXPONENT NEG WE WILL DIVIDE
CAIL C,13
JRST ERROV1
IMUL A,.TEN.(C)
JRST ALLDON
DIVOUT: MOVNS C
CAIL C,13
JRST [SETZ A,
JRST ADON ]
MOVE C,.TEN.(C)
IDIV A,C
ASH C,-1
CAML B,C; ROUND POSITIVELY
AOJA A,ALLDON
MOVNS B
CAML B,C
SOJ A,
ALLDON: JOV ERROV1; CHECK FOR OVERFLOW
ADON: MOVEM A,RACS+1(USER)
JRST RESTR
ERROV1: PUSHJ P,ERROV
JRST ADON
SUBTTL FREE FIELD NUMBER SCANNER LOU PAUL
DSCR NUMIN
DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
⊗
NUMIN:
;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
;SCANNING IS ACCORDING TO THE FOLLOWING BNF
;<NUMBER>::=<DEL><SIGN><NUM><DEL>
;<NUM> ::=<NO>|<NO><EXP>|<EXP>
;<NO> ::=<INTEGER>|<INTEGER>.|
; <INTEGER>.<INTEGER>|.<INTEGER>
;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
;<EXP> ::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
;<SIGN> ::=+|-|<EMPTY>
;NULL AND CARR. RET. ARE IGNORED.
;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
;CLASS 0 NULL, CARR RET, NOTHING
;CLASS 1 .
;CLASS 2 -
;CLASS 3 +
;CLASS 4 @,E
;CLASS 5 ANY OTHER CHARACETR
;CLASS 6 END OF FILE
;TAB(200) IS USED FOR FND OF FILE
;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
HRRE X,TAB(D)
JRST @.+2(X)
JUMP DIG
JRST .-4
JUMP POINT
JUMP MINUS
JUMP PLUS
JUMP E
JUMP CHA
JUMP EOF>
DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
SETZ X,
LSHC X,3
JRST @.+1(X)
JUMP NULL
JUMP POINT
JUMP MINUS
JUMP PLUS
JUMP E
JUMP CHA
JUMP CHA>
MOVE CHNL,-2(P)
LOADI7 A,<IN>
PUSHJ P,GETCHN; SET UP FOR INPUT
SETZM @ENDFL(CDB); CLEAR EOF AND BREAK FLAGS
SETZM @BRCHAR(CDB)
MOVE LPSA,[JSP X,NCH]
MOVEI Z,1; FOR LINE NUMBER TEST
PUSHJ P,SCAN
MOVEM D,@BRCHAR(CDB); FIX UP BREAK CHARACTER
SOS IBP(CDB) ;BACK UP TO GET IT NEXT TIME
FOR II←1,4 <
IBP IBP(CDB)>
AOS ICOWNT(CDB)
POPJ P,
SCAN: JOV .+1
SETO Q,
SETZ Y,
SETZB A,C; NUMBER EXPOENT
MORE: XCT LPSA; THIS GETS A CHARACTER IN D,200 IF FO EOF
AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
STACK: LSHC X,-3; PUSH SYMBOL ONTO STACK "AC Y"
JRST MORE
DIG1: SETZ Q,; FLAG REG.
ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
SIG1: TRO Q,4; NEGATIVE SIGN
SIG2: ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)
EXP1: MOVEI A,1
ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)
SIG3: MOVNS A
SIG4: ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)
FRA1: TRO Q,1; DECIMAL POINT
SOJ C,
ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
SIG5: TRO Q,4; NEGATIVE SIGN
SIG6: ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)
EXP2: HLRE FF,TAB(D); FIRST DIGIT
EXP5: XCT LPSA; GET NEXT CHARACTER
EXP9: HLRE B,TAB(D)
JUMPL B,EEXP; NEGATIVE IF NOT A DIGIT
IMULI FF,12
ADD FF,B
JRST EXP5
XCT LPSA
EEXP: AHEAD(EXP9,ERR2,ERR5,ERR5,ERR1,EN,EN)
EN: TRNE Q,4; SIGN OF EXPONENT
MOVNS FF
ADD C,FF; FIX UP EXPONENT
JOV ERR3
DONE: ANDI D,177
JUMPGE Q,.+2
SETO D,
POPJ P,
INT1: HLRE A,TAB(D); FIRST DIGIT
TRNE Q,4
MOVNS A; NEGATE IF NECESSARY
INT2: XCT LPSA; GET NEXT CHARACTER
INT5: HLRE B,TAB(D)
JUMPL B,EON; NEGATIVE IF NOT A NUMBER
TRNE Q,1; IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
SOJ C,
TRNE Q,2; IF ENOUGH DIGITS THEN INC EXP BY ONE
INT3: AOJA C,INT2
MOVE X,A
IMULI A,12
TRNE Q,4; NEGATE DIGIT IS SIGN NEGATIVE
MOVNS B
ADD A,B
JOV INT4; CHECK FOR OVERFLOW
JRST INT2; IF SO USE LAST VALUE
INT4: TRO Q,2
MOVE A,X
JRST INT3
XCT LPSA
EON: AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
DP1: TROE Q,1
JRST ERR2
XCT LPSA
AHEAD(INT5,ERR2,ERR5,ERR5,EXP6,DONE,DONE)
EXP6: SETZ Q,
XCT LPSA
AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
EXP7: TRO Q,4
EXP8: XCT LPSA
AHEAD(EXP2,ERR2,ERR5,ERR5,ERR1,ERR1,ERR1)
NCH: SOSG ICOWNT(CDB); DECREMENT CHARACTER COUNT
JRST NCH2
NCH1: ILDB D,IBP(CDB); LOAD BYTE
TDNE Z,@IBP(CDB); CHECK FOR LINE NUMBER
JRST NCH5
JRST (X); RETURN
NCH2: XCT IOIN,SIMIO; INPUT
JRST NCH1 ;ALL OK
;EOF OR DATA ERROR
NCH7: MOVEI D,200
JRST (X)
NCH5: AOS IBP(CDB); WE HAVE A LINE NUMBER
MOVNI TEMP,5; MOVE OVER IT
ADDB TEMP,ICOWNT(CDB)
SKIPLE TEMP; NOTHING LEFT
JRST NCH; DO ANOTHER INPUT
XCT IOIN,SIMIO
NCH6: SOSG ICOWNT(CDB); REMOVE TAB
JRST NCH7 ;NONE THERE OR ERROR
IBP IBP(CDB)
JRST NCH
STRIN: MOVE LPSA,[JSP X,NCHA]
HRRZ Z,-3(P)
HRRZ Z,-1(Z)
PUSHJ P,SCAN
HRRZ X,-3(P)
SOS (X) ;BACK UP BYTE POINTER
FOR II←1,4<
IBP (X)>
AOJ Z,
HRRM Z,-1(X)
MOVEM D,@-2(P) ;STORE BREAK CHARACTER
POPJ P,
NCHA: SOJL Z,NCH7
HRRZS -4(P)
ILDB D,@-4(P)
JRST (X)
ERR1: ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)
ERR2: ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)
ERR3: ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)
ERR5: ERR(<NUMIN: MISPLACED SIGN>,1,RZ)
ERROV: ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)
RZ: SETZ A,
JRST DONE
TAB: FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,6,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
>
FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
>
FOR A IN (5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
XWD -1,6
ENDCOM(NUM)
COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
⊗
↑↑.CH.: 4
7
16
33
66
153
777777777775
777777777772
777777777763
777777777746
777777777713
777777777626
↑↑.MT.: 240000000000
310000000000
234200000000
276570200000
216067446770
235613266501
314631463147
243656050754
321556135310
253630734215
346453122767
317542172553
↑↑.TEN.: 1
=10
=100
=1000
=10000
=100000
=1000000
=10000000
=100000000
=1000000000
=10000000000
ENDCOM(TBB)
IFN ALWAYS,<
BEND
>;IFN ALWAYS
COMPIL(WRD,<ARRYOUT,WORDOUT,ARRYIN,WORDIN>
,<GETCHN,SAVE,RESTR,GOGTAB,SIMIO,X22,X33,X44,NOTOPN>
,<ARRYIN, ARRYOUT, WORDIN, AND WORDOUT>)
COMMENT ⊗Arryout, Wordout ⊗
DSCR ARRYOUT(CHANNEL,@STARTING LOC,EXTENT);
CAL SAIL
⊗
HERE (ARRYOUT)
PUSHJ P,SAVE
MOVE LPSA,[XWD 4,4]
ARO: MOVE CHNL,-3(P)
LOADI7 A,<ARRYOUT>
PUSHJ P,GETCHN
LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CAIGE TEMP,10 ;MAKE SURE AT LEAST BINARY MODE
ERR <ARRYOUT: MODE MUST BE '14,'10, OR '17, NOT >,6
MOVE 0,[XCT IODOUT,SIMIO] ;IN CASE DUMP MODE
CAIL TEMP,15
JRST ARYDMP ;COMMON DUMP MODE ROUTINE
OUTRAY: MOVE A,-2(P) ;STARTING LOC
SKIPGE B,-1(P) ;EXTENT
ERR <ARRYOUT: NEGATIVE WORD COUNT, VALUE IS>,6
;;#FQ# DCS 2-6-72 (1-4) COUNT NO LONGER HELD EXCESSIVE
WOUT2: SKIPG E,OCOWNT(CDB) ;# WORDS LEFT IN BUFFER
JRST WOUT5 ;BETTER GET ANOTHER BUFFER
JUMPE B,RESTR ;NOTHING LEFT TO DO
IBP OBP(CDB) ;MAKE SURE PTRS TO FIRST WORD
MOVE C,OBP(CDB) ;"TO" ADDR
HRRZI D,(C) ;FOR BLT TERMINATION CALCULATION
HRLI C,(A) ;"FROM" ADDR
CAIGE B,(E) ;ENUFF IN BUFFER?? (NOTICE THAT CAIGE
;AS OPPOSED TO CAIG WILL FORCE AN OUTPUT
;IF WE JUST FILL THE BUFFER)
JRST WOUT3 ;YES
ADDI D,-1(E) ;FINAL ADDR
BLT C,(D) ;DO IT!
ADDI A,(E) ;UPDATE PTR
SUBI B,(E) ;AND COUNT
SETZM OCOWNT(CDB)
HRRM D,OBP(CDB)
WOUT5: XCT IOOUT,SIMIO ;DO THE OUTPUT
JFCL ;ERRORS HANDLED ALREADY
JRST WOUT2 ;TRY NEXT CHUNK
WOUT3: JUMPLE B,RESTR ;NOTHING TO MOVE
SUBI B,1
ADD D,B ;END OF BLOCK
BLT C,(D) ;MOVE IT
SUBI E,1(B) ;FIX LENGTH
MOVEM E,OCOWNT(CDB) ;
ADDM B,OBP(CDB) ;FIX BYTE POINTER
;;#FQ# (1-4)
JRST RESTR ;LEAVE LIKE A TREE AND MAKE
DSCR WORDOUT(CHAN,VALUE);
CAL SAIL
⊗
HERE (WORDOUT) ;WRITE ONE WORD
PUSHJ P,SAVE
MOVE LPSA,X33
MOVE CHNL,-2(P)
LOADI7 A,<WORDOUT>
PUSHJ P,GETCHN
LDB A,[POINT 4,DMODE(CDB),35];DATA MODE
CAIL A,15 ;A DUMP MODE?
JRST DMPWO ;WO IS ME, YES
;;#FQ# DCS 2-6-72 (2-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
WDO: SOSL OCOWNT(CDB) ;BUFFER FULL?
JRST WOKO ;NO
XCT IOOUT,SIMIO ;YES, WRITE IT
JFCL ; ERRORS HANDLED ELSEWHERE
JRST WDO ;GO BACK AND DO IT RIGHT
WOKO: MOVE TEMP,-1(P) ;THING TO BE WRITTEN
IDPB TEMP,OBP(CDB) ;WRITE IT
JRST RESTR
DMPWO: MOVE LPSA,[XWD 7,7] ;ACCOUNT FOR EVERYTHING
MOVEI TEMP,-1(P) ;→WORD TO BE WRITTEN
PUSH P,-2(P) ;CHANNEL
PUSH P,TEMP ;ADDR OF WORD
PUSH P,[1] ;COUNT
PUSHJ P,ARO ;JOIN THE ROUTINE (RETAD JUST FOR STACK SYNCH)
;;#FQ# (2-4)
COMMENT ⊗Arryin, Wordin ⊗
DSCR ARRYIN(CHAN,@STARTING LOC,EXTENT);
CAL SAIL
⊗
HERE (ARRYIN)
PUSHJ P,SAVE
MOVE LPSA,X44
ARI: MOVE CHNL,-3(P)
LOADI7 A,<ARRYIN>
PUSHJ P,GETCHN
SETZM @ENDFL(CDB) ;ASSUME NO END OF FILE
LDB TEMP,[POINT 4,DMODE(CDB),35] ;CHECK DUMP MODE
CAIGE TEMP,10
ERR <ARRYIN: MODE MUST BE '10 OR '14 OR '17, NOT >,6
MOVE 0,[XCT IODIN,SIMIO] ;IN CASE DUMP MODE
CAIL TEMP,15
JRST ARYDMP ;USE COMMON ROUTINE
;;#FQ# DCS 2-6-72 (3-4) COUNT NO LONGER HELD EXCESSIVE
INARY: MOVE A,-2(P) ;STARTING LOC
SKIPGE B,-1(P) ;EXTENT
ERR <ARRYIN: NEGATIVE WORD COUNT, VALUE IS >,6
WIN3: JUMPE B,RESTR ;NOTHING LEFT TO DO
SKIPG E,ICOWNT(CDB) ;#LEFT IN BUFFER
JRST WIN5
IBP IBP(CDB) ;MAKE SURE PTS TO NEXT
HRL C,IBP(CDB) ;ADDR OF FIRST WORD TO READ
MOVEI D,(A) ;FOR BLT TERMINATION
HRR C,A ;"TO" ADDRESS
CAIG B,(E) ;ENOUGH HERE?
JRST WIN4 ;YES
ADDI D,-1(E) ;NO, FINISH THIS BUFFER
BLT C,(D)
ADD A,E ;FIX INPUT POINTER
SUB B,E ;FIX INPUT COUNT
WIN5: XCT IOIN,SIMIO ;DO INPUT
JRST WIN3 ;OK, GO AHEAD
JRST WIEOF1 ;EOF OR ERROR, LEAVE
WIN4: ADDI D,-1(B) ;FINISH UP
BLT C,(D)
SUB E,B ;FIX UP COUNT
SUBI B,1 ;PREPARE TO CORRECT BP
MOVEM E,ICOWNT(CDB) ;UPDATE WORDS LEFT
ADDM B,IBP(CDB) ; POINTER
;;#FQ# (3-4)
JRST RESTR ;LEAVE
WIEOF1: MOVE TEMP,-1(P) ;#WORDS WANTED -1
SUBM TEMP,B ;#INPUT IN RH
WIN2: HRRM B,@ENDFL(CDB) ;#INPUT IN RH, ERR OR EOF BITS IN LH
JRST RESTR
DSCR VALUE←WORDIN(CHAN);
CAL SAIL
⊗
HERE (WORDIN) ;READ ONE WORD -- USE ARRYIN
PUSHJ P,SAVE
MOVE LPSA,X22
LOADI7 A,<WORDIN>
MOVE CHNL,-1(P) ;CHANNEL NUMBER
PUSHJ P,GETCHN
;;#FQ# DCS 2-6-72 (4-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
LDB TEMP,[POINT 4,DMODE(CDB),35];DATA MODE
CAIL TEMP,15 ;DUMP MODE?
JRST DUMPWI ; YES
SETZM @ENDFL(CDB)
WI: SOSL ICOWNT(CDB)
JRST WOKI ;ALL OK
XCT IOIN,SIMIO
JRST WI ;OK, GO BACK TO KEEP COUNT RIGHT
TDZA A,A ;RETURN 0, WITH ERROR
WOKI: ILDB A,IBP(CDB) ;OK, RETURN NEXT WORD
MOVEM A,RACS+1(USER) ;RESULT
JRST RESTR
DUMPWI: MOVE LPSA,[XWD 6,6]
MOVEI TEMP,RACS+1(USER);RESULT GOES HERE
PUSH P,-1(P) ;CHANNEL
PUSH P,TEMP ;ADDRESS
PUSH P,[1] ;1 WORD TRANSFER
PUSHJ P,ARI ;WON'T RETURN, JUST SYNCH STACK
;;#FQ# (4-4)
ARYDMP:
MOVN TEMP,-1(P) ;-WORD COUNT
JUMPGE TEMP,[ERR <DUMP MODE WORD COUNT NOT POSITIVE, VALUE IS >,6]
SOS D,-2(P) ;STARTING ADDR - 1
HRL D,TEMP ;IOWD -COUNT,STARTING ADDR -1
MOVEI D+1,0 ;TERMINATE THE READ
MOVE A,[JRST RESTR] ;IF IT SUCCEEDS
MOVE B,[JRST RESTR] ;IF IT FAILS (EOF OR ERR, ALREADY HANDLED)
JRST 0 ;GO DO DUMP I/O
ENDCOM(WRD)
COMPIL(LIN,<LINOUT>,<SIMIO,SAVE,RESTR,GETCHN,X33>,<LINOUT ROUTINE>)
COMMENT ⊗Linout ⊗
DSCR LINOUT(CHANNEL,VALUE);
CAL SAIL
⊗
HERE (LINOUT)
PUSHJ P,SAVE
MOVE CHNL,-2(P) ;CHANNEL
LOADI7 A,<LINOUT>
PUSHJ P,GETCHN ;CHANNEL DATA
MOVE TEMP,OBP(CDB) ;ADJUST TO FULL WORD
HRRZ A,OCOWNT(CDB) ;DON'T FORGET COUNT
LINOLP: TLNN TEMP,760000 ;LINED UP?
JRST OKLIGN ; YES
IBP TEMP ;0 WILL BE THERE
SOJA A,LINOLP
OKLIGN: MOVEM TEMP,OBP(CDB)
MOVEM A,OCOWNT(CDB) ;REPLACE UPDATED THINGS
CAIGE A,=10 ;ENOUGH ROOM FOR 2 WORDS?
XCT IOOUT,SIMIO ;NO, OUTPUT
JFCL ;IN CASE OUTPUT HAPPENED
SKIPGE B,-1(P) ;GET LINE NUMBER
JRST [MOVNS B
MOVNI A,5 ;ONLY PUT OUT 5 CHARS
JRST NOCONV] ;WAS GIVEN TO US IN TOTO
MOVNI A,6 ;PUT OUT TAB AFTER
MOVE C,[<ASCII /00000/>/2] ;TO MAKE 5
EXCH B,C
PUSH P,LNBAK ;RETURN ADDR
LNCONV: IDIVI C,=10
IORI D,"0"
DPB D,[POINT 7,(P),6]
SKIPE C ;THE RECURSIVE PRINTER
PUSHJ P,LNCONV
HLL C,(P) ;ONE CHAR, LEFT JUST
LSHC B,7
LNBAK: POPJ P,.+1
LSH B,1
TRO B,1
NOCONV: AOS C,OBP(CDB) ;MOVE OUT A WORD
MOVEM B,(C)
ADDM A,OCOWNT(CDB) ;UPDATE COUNT
MOVEI B,11
CAME A,[-5]
IDPB B,OBP(CDB) ;OUTPUT A TAB
NOTAB: MOVE LPSA,X33
JRST RESTR ;THAT'S IT
ENDCOM(LIN)
COMPIL(BRK,<BREAKSET,SETBREAK,STDBRK>
,<SAVE,RESTR,BRKMSK,SIMIO,GOGTAB,X22,X33>
,<BREAKSET, SETBREAK, STDBRK ROUTINES>)
COMMENT ⊗Breakset ⊗
DSCR BREAKSET(TABLE #,"STRING",WAY);
CAL SAIL
⊗
HERE (BREAKSET)
PUSHJ P,SAVE ;SAVE ACS AND THINGS
MOVE LPSA,X33
SUB SP,X22
SKIPLE A,-2(P) ;TABLE #
CAILE A,=18
ERR <THERE ARE ONLY 18 BREAK TABLES>
HLLZ B,BRKMSK(A) ;BREAK MASK FOR THIS TABLE
ADD A,USER
MOVE C,[ANDCAM B,(D)] ;USUAL CLEARING INSTR
LDB X,[POINT 4,-1(P),35] ;COMMAND
TRZN X,10 ;LEFT OR RIGHT HALF OF TABLE?
SKIPA X,BKCOM(X) ;RIGHT HALF
HLRZ X,BKCOM(X) ;LEFT HALF
JRST (X) ;DISPATCH
BKCOM: XWD XCLUDE,PASLINS ;X,,P
XWD INCL,PENDCH ;I,,A
XWD ILLSET,RETCH ;-,,R
XWD ILLSET,SKIPCH ;-,,S
XWD BRKLIN,DSPSET ;L,,D
XWD ILLSET,ERMAN ;-,,E
XWD NOLINS,ILLSET ;N,,-
XWD OMIT,ILLSET ;O,,-
ILLSET: ERR <ILLEGAL COMMAND TO BREAKSET>,1
JRST RESTR
XCLUDE: SKIPA C,[IORM B,(D)] ;YES, SET ALL TO 1 TO INITIALIZE
OMIT: MOVSS B ;OMIT, PUT BIT IN RH
INCL: MOVSI D,-200
HRRI D,BRKTBL(USER) ;RELOCATABLE IOWD
BRKLUP: XCT C ;CLEAR (OR SET) PROPER (HALF OF PROPER) TABLE
AOBJN D,BRKLUP
MOVE C,[IORM B,BRKTBL(D)] ;USUAL SETTING INSTR
CAIN X,XCLUDE ;BY EXCEPTION?
MOVE C,[ANDCAM B,BRKTBL(D)] ;YES, WANT TO TURN OFF BITS
ADDI C,(USER) ;RELOCATE IT
HRRZ A,1(SP) ;LENGTH OF STRING
MOVE X,2(SP) ;BYTE POINTER
JRST BRKL2
BRKL1: ILDB D,X ;GET A CHAR
XCT C ;DO RIGHT THING TO RIGHT BIT
BRKL2: SOJGE A,BRKL1
JRST RESTR
PASLINS: TDZA B,B ;PASS LINE NOS. SINE COMMENT
NOLINS: MOVEI B,-1 ;INFORM IN THAT IT SHOULD
MOVEM B,LINTBL(A) ; DELETE LINE NOS.
JRST RESTR
BRKLIN: SKIPA B,[-1] ;MARK BREAK ON LINE NOS. FOR THIS TBL
ERMAN: MOVSI B,-1 ;LH NEG SIGNALS ERMAN'S SCHEME
MOVEM B,LINTBL(A)
JRST RESTR
PENDCH: SETOM DSPTBL(A) ;APPEND TO END OF INPUT
JRST RESTR
SKIPCH: TDZA B,B ;CHAR NEVER APPEARS IN INPUT STRING
RETCH: MOVEI B,-1 ;RETAIN FOR NEXT TIME
MOVEM B,DSPTBL(A)
JRST RESTR
DSPSET: SETOM PGNNFL(USER) ;WE'RE DISPLAYING PAGE/LINE NUMBERS ON DPY
JRST RESTR
COMMENT ⊗Setbreak
TBL IS AS IN BREAKSET
BRKSTRNG IS USED FOR ANY "I" OR "X" APPEARING IN MODESTRNG
OMITSTRNG (IF NOT NULL) IS USED TO SET THE "OMIT" SIDE OF THE TABLE
MODESTRNG CAN CONTAIN ANY OF THE VALID BREAKSET "MODE" CHARACTERS
I,X,O,N,R,A,P, or S.
This function is not attainable by the user unless he declares it.
⊗
DSCR SETBREAK(TABLE,"BREAKSTRING","OMITSTRING",MODESTRING");
CAL SAIL
⊗
HERE (SETBREAK)
HRRZ TEMP,-3(SP) ;DO OMIT STRING, IF PRESENT
JUMPE TEMP,NO.O ;NULL STRING DOESN'T COUNT
PUSH P,-1(P) ;TABLE #
PUSH SP,-3(SP) ;OMIT CHARACTERS
PUSH SP,-3(SP)
PUSH P,["O"] ;OMIT!
PUSHJ P,BREAKSET ;DO THAT
NO.O: HRRZS -1(SP) ;COUNT OF # OF COMMANDS
BKSLUP: SOSGE -1(SP) ;DONE?
JRST BKSDUN ; YES
PUSH P,-1(P) ;TABLE #
ILDB TEMP,(SP) ;COMMAND
PUSH P,TEMP
PUSH SP,-5(SP)
PUSH SP,-5(SP) ;STRING TO USE IF NECESSARY
PUSHJ P,BREAKSET
JRST BKSLUP ;DO IT -- AGAIN
BKSDUN: SUB P,X22
SUB SP,[XWD 6,6]
JRST @2(P)
COMMENT ⊗Stdbrk ⊗
DSCR STDBRK(CHANNEL);
CAL SAIL
⊗
HERE (STDBRK)
PUSHJ P,SAVE
MOVE LPSA,X22
MOVE CHNL,-1(P)
MOVEI CDB,D-DMODE ;SO WE CAN USE SIMIO'S OPEN
MOVEI D,17 ;DUMP MODE
MOVE D+1,['SYS ']
MOVEI D+2,0 ;NO HEADERS
XCT IOOPEN,SIMIO ;DO THE OPEN
ERR <DSK NOT AVAILABLE?>
MOVEI USER,D-FNAME ;SO WE CAN USE SIMIO'S LOOKUP
MOVE D,['BKTBL ']
MOVE D+1,['BKT '] ;FUNNY NAME AND EXTENSION
SETZB D+2,D+3
XCT IOLOOKUP,SIMIO ;DO THE LOOKUP
ERR <STANDARD BREAK TABLE NOT AVAILABLE>
MOVE USER,GOGTAB
MOVEI D,DSPTBL-1(USER)
HRLI D,-(=19+=19+=128) ;IOWD SIZE,LOC
MOVEI D+1,0 ;TERMINATE COMMAND LIST
XCT IODIN,SIMIO ;DO THE INPUT
SKIPA ;ALL WENT WELL
ERR <PROBLEM READING STANDARD BREAK TABLE>
;; XCT IORELEASE NOW TAKES INHIBIT BITS IN RH OF D
MOVEI D,0 ;NO INHIBIT BITS TO RELEASE
XCT IORELEASE,SIMIO ;RELEASE FILE
JRST RESTR
ENDCOM(BRK)
COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X22>,<CLOSE ROUTINES>)
COMMENT ⊗Close, Closin, Closo
CLOSE(CHAN)
CLOSIN closes only the input side
CLOSO closes only the output side
⊗
DSCR CLOSIN(CHAN)
CAL SAIL
⊗
HERE (CLOSIN) PUSHJ P,SAVE ;CLOSE INPUT ONLY
MOVEI D,1
JRST CLSS
DSCR CLOSO(CHANNEL);
CAL SAIL
⊗
HERE (CLOSO)
PUSHJ P,SAVE ;CLOSE OUTPUT ONLY
MOVEI D,2
JRST CLSS
DSCR CLOSE(CHANNEL);
CAL SAIL
⊗
.CLS:
HERE (CLOSE) ;CLOSE BOTH
PUSHJ P,SAVE ;SAVE ACS AND THINGS
MOVEI D,0
CLSS: MOVE CHNL,-1(P)
MOVE LPSA,X22
CHKCHN CHNL,<CLOSE> ;VERIFY OK CHANNEL
SKIPN CDB,@CDBLOC(USER) ;GET CDB
JRST RESTR ;NOT OPEN, DON'T CLOSE
XCT IOCLOSE,SIMIO ;CLOSE CHAN,SPEC
SETZM INAME(CDB)
SETZM ONAME(CDB) ;NO FILE NAMES OPEN
JRST RESTR ;RETURN
ENDCOM(CLS)
COMPIL(MTP,<MTAPE,USETI,USETO,RENAME>
,<SAVE,RESTR,GETCHN,SIMIO,FILNAM,X22,X33,X44>
,<MTAPE, USETI, USETO, RENAME ROUTINES>)
COMMENT ⊗Mtape ⊗
DSCR MTAPE(CHANNEL,MODE);
CAL SAIL
⊗
.MTP:
HERE (MTAPE)
PUSHJ P,SAVE
MOVE LPSA,X33
MOVE CHNL,-2(P) ;CHANNEL NUMBER
LOADI7 A,<MTAPE>
PUSHJ P,GETCHN
LDB C,[POINT 5,-1(P),35] ;PART OF COMMAND CHAR
MOVE A,OPTAB ;COMMAND BITS
MOVE B,OPTAB+1 ;MORE
TRZE C,30 ;COMPRESS TABLE
ADDI C,5
LSH C,2 ;EACH COMMAND IS 4 BITS
ROTC A,(C) ;GET RIGHT COMMAND
ANDI B,17 ;DO IF SYSTEM DOESN'T
HRLI B,(<MTAPE>) ;CREATE MTAPE OPERATION
DPB CHNL,[POINT 4,B,12]
TRNE B,-1 ;IS THERE AN OPERATION?
XCT B ;YES, DO IT
JRST RESTR
OPTAB: BYTE (4) 16,17,0,0,3,6,7,13,10 ;A,B,E,F,R,S,T
BYTE (4) 11,0,1 ;U,W
COMMENT ⊗ Useti, Useto, Rename ⊗
DSCR USETI,USETO(CHANNEL,BLOCK #);
CAL SAIL
⊗
HERE (USETI)
↑↑.USETI:
SKIPA LPSA,[XCT IOSETI,SIMIO] ;USETI
HERE (USETO)
↑↑.USETO:
MOVE LPSA,[XCT IOSETO,SIMIO] ;USETO
PUSHJ P,SAVE
MOVE CHNL,-2(P)
LOADI7 A,<USET>
PUSHJ P,GETCHN
MOVE A,-1(P) ;VALUE TO USETO
MOVE LPSA+1,[JRST .+2] ;BE ABLE TO GET BACK
JRST LPSA ;GO TO USETI/O
MOVE LPSA,X33
JRST RESTR
DSCR RENAME(CHANNEL,"NEW NAME",PROTECTION,@FAILURE FLAG);
CAL SAIL
⊗
HERE (RENAME)
↑↑.RENAME:
PUSHJ P,SAVE
SETZM @-1(P)
MOVE LPSA,X44
LOADI7 A,<RENAME>
MOVE CHNL,-3(P)
PUSHJ P,GETCHN
PUSHJ P,FILNAM ;PARSE FILENAME SPEC
JRST BDSPC ;SPECIFICATION NO GOOD
MOVE TEMP,-2(P)
ROT TEMP,-=9
MOVEM TEMP,FNAME+2(USER)
XCT IORENAME,SIMIO ;DO THE RENAME
JRST RNERR ;NO GOOD
JRST RESTR
BDSPC: HRRZ TEMP,ERRTST(CDB) ;SEE IF
TRNE TEMP,10000 ;WILLING TO HANDLE ERROR
ERR <RENAME: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
SKIPA TEMP,[=8] ;ALWAYS REPORT CODE
RNERR: HRRZ TEMP,FNAME+1(USER) ;RETURN HORSESHIT NUMBER
HRROM TEMP,@-1(P) ;TO THE USER
JRST RESTR
ENDCOM(MTP)
COMPIL(USC,<USERCON>,<SAVE,RESTR,GOGTAB>,<USERCON ROUTINE>)
COMMENT ⊗Usercon ⊗
DSCR USERCON(@INDEX,@SETGET,FLAG);
CAL SAIL
PAR INDEX is USER-table displacement (usually obtained from HEAD.REL)
SETGET is used to communicate USER table values
FLAG is "OPCODE" input to USERCON
RES The INDEXth USER table entry is accessed (GLUSER table if FLAG negative).
On exit, SETGET contains old value of this entry.
If FLAG is odd, the original SETGET value replaces this entry.
⊗
HERE(USERCON)
PUSHJ P,SAVE
MOVE LPSA,[XWD 4,4]
MOVE A,-1(P) ;THE FLAG
GLOB <
MOVEI B,ENDREN
JUMPL A,[MOVEI USER,GLUSER
MOVEI B,ZAPEND ;USE GLOBAL TABLE
JRST .+1]
SKIPL C,-3(P) ;THE INDEX
CAML C,B
>;GLOB
NOGLOB <
SKIPL C,-3(P) ;THE INDEX
CAIL C,ENDREN ;CHECK BOUNDS
>;NOGLOB
ERR <USERCON INDEX OUT OF BOUNDS >,7,RESTR
ADD C,USER ;POINT AT CORRECT ENTRY
MOVE B,(C) ;GET OLD VALUE
MOVE D,@-2(P) ;(PERHAPS) NEW VALUE
TRNE A,1 ;STORE NEW VALUE?
MOVEM D,(C) ;YES
MOVEM B,@-2(P) ;RETURN OLD VALUE
GLOB <
MOVE USER,GOGTAB ;RESET
>;GLOB
JRST RESTR
ENDCOM(USC)
COMMENT ⊗Ttyuuo functions ⊗
DSCR TTYUUO FUNCTIONS
CAL SAIL
⊗
Comment ⊗
INTEGER PROCEDURE INCHRW;
RETURN A CHAR FROM TTCALL 0,
INTEGER PROCEDURE INCHRS;
RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (TTCALL 2,)
STRING PROCEDURE INCHWL;
WAIT FOR A LINE, THEN RETURN IT (TTCALL 4, FOLLOWED BY TTCALL 0'S)
STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0,
STR←LINE (TTCALL 5, FOLLOWED BY TTCALL 0'S)
STRING PROCEDURE INSTR(INTEGER BRCHAR);
RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (TTCALL 0'S)
STRING PROCEDURE INSTRL(INTEGER BRCHAR);
WAIT FOR ONE LINE, THEN DO INSTR (TTCALL 4, FOLLOWED BY INSTR)
STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0,
STR←INSTR(BRCHAR)
PROCEDURE OUTCHR(INTEGER CHAR);
OUTPUT CHAR (TTCALL 1)
PROCEDURE OUTSTR(STRING STR);
OUTPUT STR (TTCALL 3)
PROCEDURE CLRBUF;
CLEARS INPUT BUFFER (TTCALL 11,)
TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
TTYINL DOES A WAIT FOR LINE FIRST.
FULL BREAKSET CAPABILITIES EXCEPT FOR
"R" MODE (AND OF COURSE, LINE NUM. STUFF)
TITLE TTYUUO
⊗
COMPIL(TTY,<INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR
ENTINT <INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL>>
,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.>
,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#
HERE (INCHRW) TTCALL A
POPJ P,
HERE (INCHRS) TTCALL 2,A ;SKIP IF CHAR WAITING
MOVNI A,1 ;ELSE RETURN -1
POPJ P,
HERE (OUTCHR) TTYUUO 1,-1(P) ;OUTPUT THE PARAMETER
SUB P,X22 ;REMOVE PARAMETER
JRST @2(P)
HERE (OUTSTR)
;;#FO# 11-18-71 DCS (1-2)
EXPO <
;;#FO#
;;#HC# 5-11-72 DCS MAKE OUTSTR BETTER IN EXPO VERSION (DUE TO LDE)
;;#MM# 5-25-73 ↓ MAKE SURE ITS LOADED BEFORE WE USE IT
MOVE USER,GOGTAB
EXCH A,-1(SP) ;LENGTH OF STRING
HRRZS A ; REALLY
EXCH B,(SP) ;PTR TO THE STRING
PUSH P,C ;NEED ANOTHER AC
JUMPLE A,OU.OUT ;DON'T DO ANYTHING
OSLOOP: MOVE C,A
SUBI A,14*5-1 ;# CHARS/CHOMP
SKIPLE A ;LOTS LEFT??
MOVEI C,14*5-1 ; YES,
MOVE LPSA,[POINT 7,SGACS(USER)];AS GOOD A PLACE AS ANY
ILDB TEMP,B
SKIPE TEMP ;NULL??
IDPB TEMP,LPSA ; NO
SOJG C,.-3
MOVEI TEMP,0 ;A NULL FOR THE END
IDPB TEMP,LPSA
TTCALL 3,SGACS(USER) ;RAISON D'ETRE
JUMPG A,OSLOOP
OU.OUT: POP SP,B
POP SP,A
POP P,C
POPJ P,
;;#HC#
;;#FO# 11-18-71 DCS (2-2) MAKE OUTSTR WORK EFFICIENTLY USING TTYMES (STANFO ONLY)
>;EXPO
NOEXPO <
HLRZ TEMP,(SP) ;SIZE/POSITION FIELDS OF BP
TRZ TEMP,7777 ;CLEAR SIZE FIELD
OR TEMP,-1(SP) ;POSITION, COUNT IN RH FOR DDTOUT
TRNN TEMP,7777 ;IF NULL STRING, QUIT
JRST QUIT
HRLM TEMP,(SP)
MOVE TEMP,[SIXBIT /TTY/] ;DEVICE FOR TTYMES
MOVEM TEMP,-1(SP)
MOVEI TEMP,-1(SP) ;POINT AT SPEC
CALLI TEMP,400047 ;WRITE FIRST CHAR FOR LENGTH CHARS
;THIS IS THE SPECIAL TTYMES UUO AS PROVIDED BY HELLIWELL
JFCL ;IT HAS BEEN KNOW TO SKIP-RETURN
QUIT: SUB SP,X22 ;REMOVE THE ARGUMENT
>;NOEXPO
;;#FO#
POPJ P, ;DONE
REDSTR: SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,=100
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
MOVNI A,=100
PUSH SP,[0] ;NULL STRING IF NOTHING DONE
PUSH SP,TOPBYTE(USER)
POPJ P,
FINSTR: CAIN TEMP,15 ;REMOVE LFD IF CR BROKE IT
TTCALL TEMP
FINS1: ADDM A,REMCHR(USER) ;NUMBER NOT USED
ADDI A,=100 ;NUMBER USED
;;#GI# DCS 2-5-72 REMOVE TOPSTR
HRROM A,-1(SP) ; TO STRING COUNT WORD
;;#GI#
JRST RESTR
HERE (INSTR) PUSHJ P,SAVE
PUSHJ P,REDSTR
MOVE B,-1(P) ;BREAK CHAR
MOVE LPSA,X22 ;# TO REMOVE
INS1: TTCALL TEMP ;NEXT CHAR
INS2: CAMN TEMP,B ;BREAK?
JRST FINSTR ; YES, ALL DONE
IDPB TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
AOJA A,INS1 ; GO BACK FOR MORE
HERE (INCHWL) PUSHJ P,SAVE
PUSHJ P,REDSTR
MOVE LPSA,X11
TTCALL 4,TEMP
;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
INS3: CAIE TEMP,12
CAIN TEMP,175
JRST DNSTR
CAIE TEMP,15 ;CR?
TRNE TEMP,600 ;CONTROL BITS ON?
JRST DNSTR ;YES
IDPB TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
TTCALL TEMP ;GET ANOTHER AND
AOJA A,INS3 ;GO HANDLE IT
DNSTR: MOVEM TEMP,.SKIP. ;SET BREAK CHAR
JRST FINSTR
;;#GF#
HERE (INCHSL) PUSHJ P,SAVE
MOVE LPSA,X22 ;PARAM (FLAG) AND RETURN
PUSHJ P,REDSTR
SETOM @-1(P) ;ASSUME FAILED
TTCALL 5,TEMP ;ARE THERE CHARS?
JRST FINSTR ;NO
SETZM @-1(P) ;YES, GET THEM
;;#GF# DCS 2-1-72 (3-3)
JRST INS3 ;USE INCHWL'S LOOP, NOT INSTR'S
;;#GF#
HERE (INSTRL) PUSHJ P,SAVE
MOVE LPSA,X22
PUSHJ P,REDSTR
TTCALL 4,TEMP
MOVE B,-1(P)
JRST INS2
HERE (INSTRS) PUSHJ P,SAVE
MOVE LPSA,X33
PUSHJ P,REDSTR
SETOM @-2(P)
TTCALL 5,TEMP
JRST FINSTR
SETZM @-2(P)
MOVE B,-1(P)
JRST INS2
HERE (CLRBUF) TTCALL 11,
POPJ P,
HERE (TTYINS) PUSHJ P,SAVE
PUSHJ P,REDSTR ;PREPARE TO MAKE A STRING
MOVE LPSA,X33
SETOM @-1(P) ;ASSUME NO CHARS
TTCALL 5,D ;SEE IF LINES WAITING
JRST FINS1 ;NONE WAINTING
JRST TYIN1 ;GO AHEAD
HERE (TTYINL)
PUSHJ P,SAVE
TTCALL 4,D ;WAIT FOR A LINE
JRST TYIN
HERE (TTYIN) PUSHJ P,SAVE
TTCALL D ;GET A CHAR
TYIN: PUSHJ P,REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
MOVE LPSA,X33 ;PREPARE TO RETURN
TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
SKIPL C,-2(P) ;TABLE #
CAILE C,=18
ERR <TTYIN: THERE ARE ONLY 18 BREAK TABLES>
HRRZ TEMP,USER
ADD TEMP,C ;TABLE NO(USER)
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVE Q,BRKMSK(C) ;GET MASK FOR THIS TABLE
HRRZ Y,USER
ADD Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
JRST TTYN1
TTYN: TTCALL D ;1 CHAR
TTYN1: TDNE Q,@Y ;BREAK OR OMIT?
JRST TTYSPC ; YES, FIND OUT WHICH
TTYC: IDPB D,TOPBYTE(USER) ;PUT IT AWAY
AOJL A,TTYN ;COUNT AND CONTINUE
JRST FINS1 ;DONE
TTYSPC: HLLZ TEMP,@Y ;WHICH?
TDNN TEMP,Q
JRST TTYN ;OMIT
MOVEM D,@-1(P)
MOVE Y,-2(P) ;WHAT TO DO WITH IT
ADD Y,USER
SKIPN Y,DSPTBL(Y)
JRST FINS1 ;DONE, NO SAVE
JUMPL Y,TTYAPP ;APPEND
ERR <CAN'T RETAIN BREAK CHAR FROM TTYIN>,1,FINS1
TTYAPP: IDPB D,TOPBYTE(USER) ;COUNT THE BREAK CHAR
ADDI A,1 ;ONE MORE HAPPY CHAR
JRST FINS1
ENDCOM(TTY)
EXPO <
COMPIL(PTY)
ENDCOM(PTY)
>;EXPO
NOEXPO <
COMPIL(PTY,<PTYGET,PTYREL,PTIFRE,PTOCNT,PTCHRW,PTCHRS
ENTINT <PTOCHS,PTOCHW,PTOSTR,BACKUP,LODED,PTYALL,PTYSTR,PTYIN>
ENTINT <PTYSTL,PTYGTL>>
,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.>
,<PTY ROUTINES>)
COMMENT ⊗Ptyuuo functions ⊗
OPDEF PTYUUO [711B8]
DSCR PTYUUO FUNCTIONS
CAL SAIL
⊗
COMMENT ⊗
BEGIN "PTYSPC"
INTEGER PROCEDURE PTYGET;
PROCEDURE PTYREL(INTEGER LINE);
INTEGER PROCEDURE PTIFRE(INTEGER LINE);
INTEGER PROCEDURE PTOCNT(INTEGER LINE);
INTEGER PROCEDURE PTCHRS(INTEGER LINE);
PROCEDURE PTOCHS(INTEGER LINE,CHAR);
PROCEDURE PTOCHW(INTEGER LINE,CHAR);
PROCEDURE PTOSTR(INTEGER LINE; STRING INFORMATION);
PROCEDURE LODED(STRING TRYAGAIN);
STRING PROCEDURE PTYALL(INTEGER LINE);
PROCEDURE BACKUP;
STRING PROCEDURE PTYSTR(INTEGER LINE,BRCHAR);
STRING PROCEDURE PTYIN(INTEGER LINE,BKTBL; REFERENCE INTEGER BRCHAR);
END "PTYSPC"
⊗
HERE (PTYGET)
SETOM .SKIP.
MOVEI A,0
PTYUUO A
SETZM .SKIP.
POPJ P,
HERE (PTYREL)
POP P,(P)
EXCH A,(P)
PTYUUO 1,A
POP P,A
JRST @2(P)
HERE (PTYGTL) PUSH P,(P) ;ANOTHER COPY OF RETURN ADDRESS.
PTYUUO 13,-2(P);POINT AT PTY LINE NUMBER
MOVE A,-1(P) ;RESULT.
SUB P,X33
JRST @3(P) ;AND RETURN.
HERE (PTYSTL) PTYUUO 14,-2(P);POINTED AT LINE NUMBER!
SUB P,X33
JRST @3(P)
HERE (PTIFRE)
MOVE TEMP,[PTYUUO 2,0]
JRST %PTY1
HERE (PTOCNT)
SKIPA TEMP,[PTYUUO 3,0]
HERE (PTCHRW)
MOVE TEMP,[PTYUUO 5,0]
%PTY1: POP P,(P)
EXCH 0,(P)
XCT TEMP
POP P,0
JRST @2(P)
HERE (PTCHRS)
POP P,(P)
EXCH 0,(P)
PTYUUO 4,0
MOVNI A,1
POP P,0
JRST @2(P)
HERE (PTOCHS)
SKIPA TEMP,[PTYUUO 6,0]
HERE (PTOCHW)
MOVE TEMP,[PTYUUO 7,0]
SETOM .SKIP.
POP P,(P)
EXCH A,(P)
EXCH 0,-1(P)
XCT TEMP
SETZM .SKIP.
POP P,A
POP P,0
JRST @3(P)
HERE (LODED)
MOVEI TEMP,0
EXCH TEMP,(P)
PUSH P,TEMP
SKIPA TEMP,[PTYUUO 15,-1(SP)]
HERE (PTOSTR)
MOVE TEMP,[PTYUUO 11,-1(SP)]
PUSH P,TEMP
MOVE USER,GOGTAB
PUSHJ P,INSET
PUSH SP,[1]
PUSH SP,[POINT 7,[0]]
PUSHJ P,CAT
POP P,TEMP
POP P,(P)
POP P,-1(SP)
XCT TEMP
SUB SP,X22
JRST @2(P)
HERE (BACKUP)
TTYUUO 10,
POPJ P,
HERE (PTYALL)
PUSHJ P,SAVE
MOVE 0,-1(P) ;LINE NUMBER
PTYUUO 3,0
JUMPE A,[PUSH SP,[0]
PUSH SP,[0]
JRST ALLQ]
MOVEI A,=450
ADDM A,REMCHR(USER)
SKIPL REMCHR(USER)
PUSHJ P,STRNGC
PUSHJ P,INSET
PUSH SP,-1(P) ;PTY LINE NUMBER
PUSH SP,TOPBYTE(USER) ;AND BYTE POINTER.
PTYUUO 10,-1(SP) ;AND ASK FOR ALL THAT IS THERE.
MOVEI B,0
MOVE C,(SP) ;BYTE POINTER.
;;#IN# 7-11-72 DCS TOPBYTE INVALIDLY UPDATED (ONE TOO FAR)
SOMMOR: MOVE LPSA,C ;LAG BY ONE #IN#
ILDB 0,C ;GET CHAR
JUMPE 0,ALLDUN
AOJA B,SOMMOR
ALLDUN: CAILE B,=445
ERR <PTYALL OVERFLOW -- IT JUST CAN'T HAPPEN!!!!>
HRROM B,-1(SP) ;SAVE AS RESULT.
MOVEM LPSA,TOPBYTE(USER);THIS IS WHERE TO START ENXT ITEM. #IN#
;;#IN#
SUBI B,=156 ;-ESTIMATE
ADDM B,REMCHR(USER) ;AND UPDATE FREE COUTN.
ALLQ: MOVE LPSA,X22
JRST RESTR
%REDSTR:SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,=100
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
MOVNI A,=100
PUSH SP,[0] ;NULL STRING IF NOTHING DONE
PUSH SP,TOPBYTE(USER)
POPJ P,
%FINSTR: CAIN TEMP,15 ;REMOVE LFD IF CR BROKE IT
PTYUUO 5,CDB
%FINS1: ADDM A,REMCHR(USER) ;NUMBER NOT USED
ADDI A,=100 ;NUMBER USED
HRROM A,-1(SP) ; AND TO STRING COUNT WORD
JRST RESTR
HERE (PTYSTR)
PUSHJ P,SAVE
PUSHJ P,%REDSTR
MOVE CDB,-2(P)
MOVE B,-1(P) ;BREAK CHAR
MOVE LPSA,X33 ;# TO REMOVE
%INS1: PTYUUO 5,CDB ;NEXT CHAR
%INS2: CAMN CHNL,B ;BREAK?
JRST %FINSTR ; YES, ALL DONE
IDPB CHNL,TOPBYTE(USER) ;PUT IT AWAY AND
AOJA A,%INS1 ; GO BACK FOR MORE
JRST %INS2
HERE (PTYIN) PUSHJ P,SAVE
MOVE CDB,-3(P)
PTYUUO 5,CDB
%TYIN: PUSHJ P,%REDSTR ;PREPARE STACK,A,STRNGC FOR A STRING
MOVE LPSA,[XWD 4,4] ;PREPARE TO RETURN
%TYIN1: SETZM @-1(P) ;ASSUME NO BREAK CHAR
SKIPL C,-2(P) ;TABLE #
CAILE C,=18
ERR <PTYIN: THERE ARE ONLY 18 BREAK TABLES>
HRRZ TEMP,USER
ADD TEMP,C ;TABLE NO(USER)
MOVEI Z,1 ;FOR TESTING LINE NUMBERS
SKIPN LINTBL(TEMP) ;DON'T LET TEST SUCCEED IF
MOVEI Z,0 ;WE'RE TO LET LINE NUMBERS THRU
MOVE Q,BRKMSK(C) ;GET MASK FOR THIS TABLE
HRRZ Y,USER
ADD Y,[XWD CHNL,BRKTBL] ;BRKTBL+RLC(USER)
JRST %TTYN1
%TTYN: PTYUUO 5,CDB
%TTYN1: TDNE Q,@Y ;BREAK OR OMIT?
JRST %TTYSPC ; YES, FIND OUT WHICH
%TTYC: IDPB CHNL,TOPBYTE(USER) ;PUT IT AWAY
AOJL A,%TTYN ;COUNT AND CONTINUE
JRST %FINS1 ;DONE
%TTYSPC: HLLZ TEMP,@Y ;WHICH?
TDNN TEMP,Q
JRST %TTYN ;OMIT
MOVEM CHNL,@-1(P)
MOVE Y,-2(P) ;WHAT TO DO WITH IT
ADD Y,USER
SKIPN Y,DSPTBL(Y)
JRST %FINS1 ;DONE, NO SAVE
JUMPL Y,%TTYAPP ;APPEND
ERR <CAN'T RETAIN BREAK CHAR FROM PTYIN>,1,%FINS1
%TTYAPP: IDPB CHNL,TOPBYTE(USER) ;COUNT THE BREAK CHAR
ADDI A,1 ;ONE MORE HAPPY CHAR
JRST %FINS1
ENDCOM(PTY)
>;NOEXPO
IFN ALWAYS,<
BEND IOSER>
DSCR BEND IOSER
⊗